#!/usr/sbin/perl --	# -*-Perl-*-

#
#
#  Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of version 2 of the GNU General Public License as
#  published by the Free Software Foundation.
#
#  This program is distributed in the hope that it would be useful, but
#  WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
#
#  Further, this software is distributed without any warranty that it is
#  free of the rightful claim of any third person regarding infringement 
#  or the like.  Any license provided herein, whether implied or 
#  otherwise, applies only to this software file.  Patent licenses, if 
#  any, provided herein do not apply to combinations of this program with 
#  other software, or any other product whatsoever.  
#
#  You should have received a copy of the GNU General Public License along
#  with this program; if not, write the Free Software Foundation, Inc., 59
#  Temple Place - Suite 330, Boston MA 02111-1307, USA.
#
#  Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
#  Mountain View, CA 94043, or:
#
#  http://www.sgi.com
#
#  For further information regarding this notice, see:
#
#  http://oss.sgi.com/projects/GenInfo/NoticeExplan
#
#


###########################################################################
###
### This file contains two parts.  The first, directly following, is a
### table which is used to define all WHIRL opcodes, types and opcode
### attributes.  This table is actually a series of perl statements
### (typically perl subroutine calls, recognizable by the & prefix).
### The second part contains the perl functions that implement
### these tables and generates C code to be used in the compiler.
###
### [Note: opcode.h is a C file that contains descriptions of functions
### generated by this perl script, e.g OPCODE_has_sym(op), etc.  Any
### changes to this file probably need to be reflected in the comments
### in opcode.h.]
###
###########################################################################


###########################################################################
###########################################################################
###########################################################################
###########################################################################
###
### PART I: tabular definition of WHIRL opcodes, types and attributes
###
###########################################################################
###########################################################################
###########################################################################
###########################################################################

# Although not necessary in perl, I've enclosed the "main program" in
# braces for documentation purposes.

{

###########################################################################
###
### Miscellaneous information.
###
###########################################################################

  $GENERAL_PREFIX = "OPCODE_";

  $GOP_PREFIX = "OPR_";
  $OP_PREFIX = "OPC_";
  $OP_TYPE = "OPCODE";
  $GOP_TYPE = "OPERATOR";

  &OUTFILES("opcode_gen_core.h",
	    "opcode_gen.h",
	    "opcode_gen_core.cxx",
	    "wn_simp_ftable.h");

#
# begin bracketing ifndef in case opcode_gen_core.h is included multiple times
#

  printf(HFILET "#ifndef opcode_gen_core_INCLUDED\n");
  printf(HFILET "#define opcode_gen_core_INCLUDED\n\n");

###########################################################################
###
### TYPES
###
### WHIRL type information, and type abbreviations used in this file.
###
### &WHIRLTYPE("I") indicates that "I" is a base type in whirl
### &ABBREVTYPE("i", "I", "J", "K", "L") shows that "i" is an abbreviation
###	for I J K L.
###
###########################################################################

  &BEGIN_WHIRLTYPE();
  &WHIRLTYPE("B");
  &WHIRLTYPE("I1");
  &WHIRLTYPE("I2");
  &WHIRLTYPE("I4");
  &WHIRLTYPE("I8");
  &WHIRLTYPE("U1");
  &WHIRLTYPE("U2");
  &WHIRLTYPE("U4");
  &WHIRLTYPE("U8");
  
  &WHIRLTYPE("F4");
  &WHIRLTYPE("F8");
  &WHIRLTYPE("FQ");
  &WHIRLTYPE("F10");
  &WHIRLTYPE("F16");

  &WHIRLTYPE("C4");
  &WHIRLTYPE("C8");
  &WHIRLTYPE("CQ");

  &WHIRLTYPE("M");
  &WHIRLTYPE("V");

  &WHIRLTYPE("BS");
  &WHIRLTYPE("A4");
  &WHIRLTYPE("A8");
  &WHIRLTYPE("C10");
  &WHIRLTYPE("C16");
  &WHIRLTYPE("I16");
  &WHIRLTYPE("U16");

  &ABBREVTYPE("i", "I4", "I8", "U4", "U8", "I16", "U16");
  &ABBREVTYPE("f", "F4", "F8", "FQ", "F10", "F16");
  &ABBREVTYPE("z", "C4", "C8", "CQ", "C10", "C16");
  &ABBREVTYPE("s", "I1", "I2", "U1", "U2");
  &ABBREVTYPE("b", "I4", "B");
  &ABBREVTYPE("p", "U4", "U8", "A4", "A8");	# depending on the model, could be either
  &ABBREVTYPE("bs", "BS");

  $OPTYPE_TYPE = "TYPE_ID";
  $OPTYPE_PREFIX = "MTYPE_";

  &END_WHIRLTYPE();

###########################################################################
###
### PROPERTIES
###
### Properties are listed here for documentation purposes.
### Also, any properties used later are checked against this list.
### Finally, the second entry is the C type of this property.
###
### &NEW_PROPERTY(prop, type) says that there is a property called
###	'prop' that has the given associated C type.  'prop' will be
###	the field name of the property.  The type "flag" is
###	implemented using one bit from a field.  The perl
###	script will generate a function called
###	OPCODE_is_'prop'($OP_TYPE) that takes an opcode and
###	returns 0 if the property doesn't exist for that opcode
###	and non-zero if it does exist for that opcode.
###     (Note that "mINT8" could be a sensible alternative to "flag"
###     for heavily used properties.)
###
### &NEW_VALUED_PROPERTY(prop, type[, dflt]) says that there is a
###	property called 'prop' that has the given associated C type.
###	This property must either have a value supplied with it for each
###	opcode, or else have a default to say what that value should be
###	if it is not supplied.  Generates a function called
###	OPCODE_'prop'($OP_TYPE) that returns the value of the property.
###
### We define some appreviations for the property names to keep this
###	file more readable.
###
###########################################################################

  $PROPERTY_ACCESSOR_PREFIX = $GENERAL_PREFIX . "is_";
  $VALUED_PROPERTY_ACCESSOR_PREFIX = $GENERAL_PREFIX . "";

  $SCF = "scf";				# structured control flow, e.g. IF
  $STMT = "stmt";			# statement, e.g. DEFLABEL
  $EXP = "expression";			# expression, e.g. ADD
  $LEAF = "leaf";			# leaf, e.g. CONST
  $STORE = "store";			# store, e.g. STID
  $LOAD = "load";			# load, e.g. LDID
  $CALL = "call";			# call, e.g. ICALL
  $CMP = "compare";			# comparison, e.g. GE
  $NSCF = "non_scf";			# non-structured cf, e.g. GOTO
  $BOOL = "boolean";			# boolean return value only, e.g. GE
  $NK = "nkids";			# number of kids, or -1 if variable
  $MC = "mapcat";			# annotation category
  $EBB = "endsbb";			# opcode ends a bb
  $CUI = "comp_unit_if";		# compilation unit interface, e.g. REGION
  $NE = "not_executable";		# e.g. COMMENT
  $PREF = "prefetch";			# a prefetch

  $HAS_NEXT_PREV = "next_prev";
  $HAS_SYM = "sym";
  $HAS_LBL_NUM = "label";
  $HAS_NE = "num_entries";
  $HAS_OFFSET = "offset";
  $HAS_2OFFSETS = "2offsets";
  $HAS_BITS = "bits";
  $HAS_NDIM = "ndim";
  $HAS_ESIZE = "esize";
  $HAS_VALUE = "value";
  $HAS_FLAGS = "flags";
  $HAS_INUMBER = "inumber";
  $HAS_1TY = "1ty";
  $HAS_2TY = "2ty";
  $HAS_EREG_SUPP = "ereg_supp";		# exception region supplement
  $HAS_BARRIER = "barrier";
  $HAS_LAST_LABEL = "last_label";

  $property_accessor_prefix{$HAS_NEXT_PREV} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_SYM} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_LBL_NUM} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_NE} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_OFFSET} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_2OFFSETS} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_BITS} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_NDIM} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_ESIZE} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_VALUE} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_FLAGS} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_INUMBER} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_1TY} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_2TY} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_EREG_SUPP} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_BARRIER} = $GENERAL_PREFIX . "has_";
  $property_accessor_prefix{$HAS_LAST_LABEL} = $GENERAL_PREFIX . "has_";

# If anything in OPCODE_MAPCAT changes, don't forget to update
# the documentation in wn_core.h

  printf(HFILET "#ifdef __cplusplus\n");
  printf(HFILET "extern \"C\" {\n");
  printf(HFILET "#endif\n\n");

  printf(HFILET "/* annotation categories */\n\n");
  printf(HFILET "typedef enum {\n");
  printf(HFILET "  OPCODE_MAPCAT_HDR = 0,\n");
  printf(HFILET "  OPCODE_MAPCAT_SCF = 1,\n");
  printf(HFILET "  OPCODE_MAPCAT_LDST = 2,\n");
  printf(HFILET "  OPCODE_MAPCAT_PRAGMA = 3,\n");
  printf(HFILET "  OPCODE_MAPCAT_OSTMT = 4,\n");
  printf(HFILET "  OPCODE_MAPCAT_OEXP = 5,\n");
  printf(HFILET "  OPCODE_MAPCAT_ARRAY = 6,\n");
  printf(HFILET "  OPCODE_MAPCAT_CALL = 7\n");
  printf(HFILET "} OPCODE_MAPCAT;\n\n");
  printf(HFILET "#define WN_MAP_CATEGORIES 8\n\n");

  $MCHDR = "OPCODE_MAPCAT_HDR";
  $MCSCF = "OPCODE_MAPCAT_SCF";
  $MCLDST = "OPCODE_MAPCAT_LDST";
  $MCPR = "OPCODE_MAPCAT_PRAGMA";
  $MCSTMT = "OPCODE_MAPCAT_OSTMT";
  $MCEXP = "OPCODE_MAPCAT_OEXP";
  $MCARRAY = "OPCODE_MAPCAT_ARRAY";
  $MCCALL = "OPCODE_MAPCAT_CALL";

  &BEGIN_PROPERTY();

  &NEW_PROPERTY($SCF, "flag");
  &NEW_PROPERTY($STMT, "flag");
  &NEW_PROPERTY($EXP, "flag");
  &NEW_PROPERTY($LEAF, "flag");
  &NEW_PROPERTY($STORE, "flag");
  &NEW_PROPERTY($LOAD, "flag");
  &NEW_PROPERTY($CALL, "flag");
  &NEW_PROPERTY($CMP, "flag");
  &NEW_PROPERTY($NSCF, "flag");
  &NEW_PROPERTY($BOOL, "flag");
  &NEW_PROPERTY($EBB, "flag");
  &NEW_PROPERTY($CUI, "flag");
  &NEW_PROPERTY($NE, "flag");
  &NEW_PROPERTY($PREF, "flag");

  &NEW_PROPERTY($HAS_NEXT_PREV, "flag");
  &NEW_PROPERTY($HAS_SYM, "flag");
  &NEW_PROPERTY($HAS_LBL_NUM, "flag");
  &NEW_PROPERTY($HAS_NE, "flag");
  &NEW_PROPERTY($HAS_OFFSET, "flag");
  &NEW_PROPERTY($HAS_2OFFSETS, "flag");
  &NEW_PROPERTY($HAS_BITS, "flag");
  &NEW_PROPERTY($HAS_NDIM, "flag");
  &NEW_PROPERTY($HAS_ESIZE, "flag");
  &NEW_PROPERTY($HAS_VALUE, "flag");
  &NEW_PROPERTY($HAS_FLAGS, "flag");
  &NEW_PROPERTY($HAS_INUMBER, "flag");
  &NEW_PROPERTY($HAS_1TY, "flag");
  &NEW_PROPERTY($HAS_2TY, "flag");
  &NEW_PROPERTY($HAS_EREG_SUPP, "flag");
  &NEW_PROPERTY($HAS_BARRIER, "flag");
  &NEW_PROPERTY($HAS_LAST_LABEL, "flag");

  &NEW_VALUED_PROPERTY($NK, "mINT8", "i", -1);        # "i": integer valued
  &NEW_VALUED_PROPERTY($MC, "OPCODE_MAPCAT", "e");     # "e": enum valued

  &END_PROPERTY();

###########################################################################
###
### OPCODES
###
### This part defines all the operators in WHIRL.  Each call defines a
### set of opcodes, all with the same generic operator.  The generic
### operator, the 'return types' allowed for that operator, the
### 'descriptor types' allowed for that operator, and the properties
### (one of those defined by NEW_PROPERTY above) are indicated.  A
### cross product of the return types and the descriptors are taken.
### If a more restrictive set of typing is desired, then multiple
### calls to OP with the same generic opcode can be performed.
###
### &OP(generic_op, return_types, descriptor_types, properties, ...)
###	The first argument to OP is a string, the name of the generic
###	opcode.  The second and third parameters are also strings, comma
###	separated types defined by WHIRLTYPE or ABBREVTYPE.  The
###	fourth and further arguments are all the properties.
###     PROPERTIES ON PROPERTY LISTS HAVE INITIAL VALUES OF 1.
###	PROPERTIES NOT ON PROPERTY LISTS HAVE AN INITIAL VALUES OF 0.
###	This makes sense, but could be generalized.  For example, if we
###	decided to make "number of kids" a property, we'd have to change
###	the script.
###
###########################################################################

  &BEGIN_OP();

  &OP("ABS",          "I4,I8,f",    "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("ADD",          "i,f,z,p",    "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("AGOTO",        "V",          "V",  $STMT, $NSCF, $EBB,
      $NK, 1, $MC, $MCSTMT, $HAS_NEXT_PREV);

  &OP("ALTENTRY",     "V",          "V",  $STMT, $NSCF,
      $MC, $MCSTMT, $HAS_NEXT_PREV, $HAS_SYM);

  &OP("ARRAY",        "p",          "V",  $EXP, $MC, $MCARRAY,
      $HAS_NDIM, $HAS_ESIZE);

  &OP("ARRAYEXP",     "i,f,z,M",    "V",  $EXP, $MC, $MCEXP);

  &OP("ARRSECTION",   "p",          "V",  $EXP, $MC, $MCARRAY, $HAS_NDIM, $HAS_ESIZE);

  &OP("ASHR",         "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("ASSERT",		"V",	"V",	$STMT, $HAS_OFFSET, $NK, 1,
	$HAS_NEXT_PREV, $MC, $MCSTMT);

  &OP("BACKWARD_BARRIER",	"V",	"V",  $STMT, $NSCF, $MC, $MCSTMT, 
      $HAS_NEXT_PREV, $HAS_BARRIER);

  &OP("BAND",         "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("BIOR",         "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("BLOCK",        "V",          "V",  $SCF, $MC, $MCSCF,
      $HAS_NEXT_PREV);

  &OP("BNOR",         "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("BNOT",         "i",          "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("BXOR",         "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

#CALL can only have a limited range of return types
  &OPKEEP(I1CALL);  &OPKEEP(I2CALL);  &OPKEEP(I4CALL);  &OPKEEP(I8CALL);
  &OPKEEP(U1CALL);  &OPKEEP(U2CALL);  &OPKEEP(U4CALL);  &OPKEEP(U8CALL);
  &OPKEEP(I4I4CALL); &OPKEEP(I8I8CALL); &OPKEEP(U4U4CALL); &OPKEEP(U8U8CALL);
  &OPKEEP(F4CALL);  &OPKEEP(F8CALL);  &OPKEEP(FQCALL);
  &OPKEEP(C4CALL);  &OPKEEP(C8CALL);  &OPKEEP(VCALL);
  &OPKEEP(F4F4CALL); &OPKEEP(F4F8CALL); &OPKEEP(F8F4CALL); &OPKEEP(F8F8CALL);
  &OPKEEP(A4CALL); &OPKEEP(A8CALL); &OPKEEP(MCALL)
  &OPKEEP(F10CALL); &OPKEEP(F16CALL);
  &OPKEEP(CQCALL);  &OPKEEP(C10CALL); &OPKEEP(C16CALL);
  &OP("CALL",         "s,i,f,z,V,p,M",  "i,F4,F8,V,p,M",  $STMT, $CALL, $EBB,
      $MC, $MCCALL, $HAS_NEXT_PREV, $HAS_SYM, $HAS_FLAGS);

  &OP("CAND",         "b",          "V",  $EXP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("CASEGOTO",     "V",          "V",  $STMT, $NSCF, $LEAF,
      $NK, 0, $MC, $MCSTMT, $HAS_NEXT_PREV, $HAS_VALUE, $HAS_LBL_NUM);

  &OP("CEIL",         "i",	    "f",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("CIOR",         "b",          "V",  $EXP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("COMMA",         "i,f,z,p,M",   "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("COMMENT",       "V",          "V",  $STMT, $LEAF, $NK, 0, $MC, $MCSTMT,
      $HAS_NEXT_PREV, $HAS_OFFSET, $NE);

  &OP("COMPGOTO",     "V",          "V",  $STMT, $NSCF, $MC, $MCSCF, $EBB,
      $HAS_NEXT_PREV, $HAS_NE, $HAS_LAST_LABEL);

  &OP("COMPLEX",      "z",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("CONST",        "i,f,z,p",         "V",
      $EXP,        $LEAF, $NK, 0, $MC, $MCEXP, $HAS_SYM);

  &OP("CSELECT",      "i,f,z,b,p,M,V","V",  $EXP, $NK, 3, $MC, $MCEXP);

  &OPIGN("I8I8CVT"); &OPIGN("I4I4CVT");
  &OPIGN("U8U8CVT"); &OPIGN("U4U4CVT");
  &OPIGN("F4F4CVT"); &OPIGN("F8F8CVT"); &OPIGN("FQFQCVT");
  &OPIGN("A4A4CVT"); &OPIGN("A8A8CVT");
  &OPIGN("F10F10CVT"); &OPIGN("F16F16CVT");
# &OPIGN("U8I8CVT"); &OPIGN("U4I4CVT"); &OPIGN("I8U8CVT"); &OPIGN("I4U4CVT");
# &OPIGN("A4I4CVT"); &OPIGN("A4U4CVT"); &OPIGN("I4A4CVT"); &OPIGN("U4A4CVT");
# &OPIGN("A8I8CVT"); &OPIGN("A8U8CVT"); &OPIGN("I8A8CVT"); &OPIGN("U8A8CVT");


  &OP("CVT",          "i,f,p",      "i,f,p",$EXP, $NK, 1, $MC, $MCEXP);

  &OP("CVTL",         "i",          "V",  $EXP, $NK, 1, $MC, $MCEXP, $HAS_BITS);

  &OP("DIV",          "i,f,z",      "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("DIVREM",       "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

# DO_LOOP has 5 or 6 kids, depending on possible LOOP_INFO
  &OP("DO_LOOP",      "V",          "V",  $SCF, $MC, $MCSCF,
      $HAS_NEXT_PREV);

  &OP("DO_WHILE",     "V",          "V",  $SCF, $NK, 2, $MC, $MCSCF,
      $HAS_NEXT_PREV);

  &OP("EQ",           "b",          "i,f,z,p",
      $EXP, $CMP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("EVAL",         "V",          "V",  $STMT, $NK, 1, $MC, $MCSTMT,
      $HAS_NEXT_PREV);

  &OP("EXC_SCOPE_BEGIN",   "V",      "V",  $STMT, $NSCF, $MC, $MCSTMT, 
      $HAS_NEXT_PREV, $HAS_OFFSET, $HAS_EREG_SUPP);

  &OP("EXC_SCOPE_END",   "V",        "V", $STMT, $NSCF, $NK, 0, $MC, $MCSTMT, 
      $HAS_NEXT_PREV, $HAS_OFFSET);

  &OP("FALSEBR",       "V",          "V",  $STMT, $NSCF, $EBB,
      $NK, 1, $MC, $MCSTMT, $HAS_NEXT_PREV, $HAS_LBL_NUM);

  &OP("FLOOR",        "i",	    "f",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("FORWARD_BARRIER",	"V",	"V",  $STMT, $NSCF, $MC, $MCSTMT, 
      $HAS_NEXT_PREV, $HAS_BARRIER);

  &OP("FUNC_ENTRY",   "V",          "V",  $SCF, $MC, $MCHDR,
      $HAS_NEXT_PREV, $HAS_SYM);

  &OP("GE",           "b",          "i,f,p",
      $EXP, $CMP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("GOTO",         "V",          "V",  $STMT, $NSCF, $LEAF, $EBB,
      $NK, 0, $MC, $MCSTMT, $HAS_NEXT_PREV, $HAS_SYM, $HAS_LBL_NUM);

  &OP("GT",           "b",          "i,f,p",
      $EXP, $CMP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("HIGHMPY",       "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("HIGHPART",     "i",          "V",  $EXP, $NK, 1, $MC, $MCEXP);

#ICALL can only have a limited range of return types
  &OPKEEP(I1ICALL);  &OPKEEP(I2ICALL);  &OPKEEP(I4ICALL);  &OPKEEP(I8ICALL);
  &OPKEEP(U1ICALL);  &OPKEEP(U2ICALL);  &OPKEEP(U4ICALL);  &OPKEEP(U8ICALL);
  &OPKEEP(I4I4ICALL); &OPKEEP(I8I8ICALL); &OPKEEP(U4U4ICALL); &OPKEEP(U8U8ICALL);
  &OPKEEP(F4ICALL);  &OPKEEP(F8ICALL);  &OPKEEP(FQICALL);
  &OPKEEP(C4ICALL);  &OPKEEP(C8ICALL);  &OPKEEP(VICALL);
  &OPKEEP(F4F4ICALL); &OPKEEP(F4F8ICALL); &OPKEEP(F8F4ICALL); &OPKEEP(F8F8ICALL);
  &OPKEEP(A4ICALL); &OPKEEP(A8ICALL); &OPKEEP(MICALL);
  &OPKEEP(F10ICALL), &OPKEEP(F16ICALL);
  &OPKEEP(CQICALL),  &OPKEEP(C10ICALL), &OPKEEP(C16ICALL);
  &OP("ICALL",        "s,i,f,z,V,p",  "i,F4,F8,V,p",  $STMT, $CALL, $EBB,
      $MC, $MCCALL, $HAS_NEXT_PREV, $HAS_1TY, $HAS_FLAGS);

  &OP("IDNAME",       "V",           "V",
      $EXP,        $LEAF, $NK, 0, $MC, $MCEXP, $HAS_SYM, $HAS_OFFSET);

  &OP("IF",           "V",          "V",  $SCF, $NK, 3, $MC, $MCSCF,
      $HAS_NEXT_PREV);

  &OP("ILDA",          "p",           "V",
      $EXP,        $NK, 1, $MC, $MCEXP,
      $HAS_OFFSET, $HAS_1TY);

  &OP("ILDBITS",         "i",  "s",  $EXP, $LOAD, $NK, 1, $MC, $MCLDST,
      $HAS_2TY, $HAS_OFFSET);

#ILOAD can only have a limited range of return types
  &OPKEEP(I8I8ILOAD);  &OPKEEP(I8I2ILOAD);  &OPKEEP(I8I1ILOAD);  &OPKEEP(I8I4ILOAD);
  &OPKEEP(I4I4ILOAD);  &OPKEEP(I4I2ILOAD);  &OPKEEP(I4I1ILOAD);  &OPKEEP(I4I8ILOAD);
  &OPKEEP(U8U8ILOAD);  &OPKEEP(U8U2ILOAD);  &OPKEEP(U8U1ILOAD);  &OPKEEP(U8U4ILOAD);
  &OPKEEP(U4U4ILOAD);  &OPKEEP(U4U2ILOAD);  &OPKEEP(U4U1ILOAD);  &OPKEEP(U4U8ILOAD);
  &OPKEEP(F4F4ILOAD);  &OPKEEP(F8F8ILOAD);  &OPKEEP(FQFQILOAD);
  &OPKEEP(C4C4ILOAD);  &OPKEEP(C8C8ILOAD);  &OPKEEP(CQCQILOAD);
  &OPKEEP(A4A4ILOAD);  &OPKEEP(A8A8ILOAD);  &OPKEEP(MMILOAD)
  &OPKEEP(I4BSILOAD);  &OPKEEP(I8BSILOAD);
  &OPKEEP(U4BSILOAD);  &OPKEEP(U8BSILOAD);
  &OPKEEP(F10F10ILOAD); &OPKEEP(F16F16ILOAD);
  &OPKEEP(C10C10ILOAD); &OPKEEP(C16C16ILOAD);
  &OP("ILOAD",         "i,f,z,p,M",  "i,f,z,s,p,M,bs",  $EXP, $LOAD, $NK, 1, $MC, $MCLDST,
      $HAS_2TY, $HAS_OFFSET);

  &OP("ILOADX",        "f",          "V",  $EXP, $LOAD, $NK, 2, $MC, $MCLDST,
      $HAS_2TY);

  &OP("IMAGPART",     "f",          "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("INTCONST",     "i,p",           "V",
      $EXP,        $LEAF, $NK, 0, $MC, $MCEXP,
      $HAS_VALUE);

#INTRINSIC_CALL can only have a limited range of return types
  &OPKEEP(I1INTRINSIC_CALL);  &OPKEEP(I2INTRINSIC_CALL);  &OPKEEP(I4INTRINSIC_CALL);  &OPKEEP(I8INTRINSIC_CALL);
  &OPKEEP(U1INTRINSIC_CALL);  &OPKEEP(U2INTRINSIC_CALL);  &OPKEEP(U4INTRINSIC_CALL);  &OPKEEP(U8INTRINSIC_CALL);
  &OPKEEP(I4I4INTRINSIC_CALL); &OPKEEP(I8I8INTRINSIC_CALL); &OPKEEP(U4U4INTRINSIC_CALL); &OPKEEP(U8U8INTRINSIC_CALL);
  &OPKEEP(F4INTRINSIC_CALL);  &OPKEEP(F8INTRINSIC_CALL);  &OPKEEP(FQINTRINSIC_CALL);
  &OPKEEP(C4INTRINSIC_CALL);  &OPKEEP(C8INTRINSIC_CALL);  &OPKEEP(VINTRINSIC_CALL);
  &OPKEEP(F4F4INTRINSIC_CALL); &OPKEEP(F4F8INTRINSIC_CALL); &OPKEEP(F8F4INTRINSIC_CALL); &OPKEEP(F8F8INTRINSIC_CALL);
  &OPKEEP(A4INTRINSIC_CALL); &OPKEEP(A8INTRINSIC_CALL); &OPKEEP(MINTRINSIC_CALL);
  &OPKEEP(F10INTRINSIC_CALL); &OPKEEP(F16INTRINSIC_CALL);
  &OPKEEP(CQINTRINSIC_CALL);
  &OPKEEP(C10INTRINSIC_CALL); &OPKEEP(C16INTRINSIC_CALL);
  &OP("INTRINSIC_CALL","s,i,f,z,V,p,M", "i,F4,F8,V,p,M",  $STMT, $CALL, $EBB,
      $MC, $MCCALL, $HAS_NEXT_PREV, $HAS_INUMBER, $HAS_FLAGS);

  &OP("INTRINSIC_OP", "i,f,z,b,p,s,M",  "V",  $EXP, $MC, $MCEXP,
      $HAS_FLAGS, $HAS_INUMBER);

  &OP("IO",           "V",          "V",  $STMT, $EBB, $MC, $MCSTMT,
      $HAS_NEXT_PREV, $HAS_INUMBER);

  &OP("IO_ITEM",      "V",          "V",  $EXP, $HAS_INUMBER, $MC, $MCEXP,
	$HAS_1TY);

  &OP("ISTBITS",      "V",          "s",  $STMT, $STORE, $NK, 2,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_OFFSET, $HAS_1TY);

  &OP("ISTORE",        "V",          "s,i,f,z,M,p,bs",  $STMT, $STORE, $NK, 2,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_OFFSET, $HAS_1TY);

  &OP("PSTORE",        "V",          "s,i,f,z,M,p,bs",  $STMT, $STORE, $NK, 2,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_OFFSET, $HAS_1TY);

  &OP("ISTOREX",       "V",          "f",  $STMT, $STORE, $NK, 3,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_1TY);

# LABEL has 0 or 1 kids, but treat as variable kids so filled in dynamically
  &OP("LABEL",        "V",          "V",  $STMT, $NSCF,
      $MC, $MCSTMT, $HAS_NEXT_PREV, $HAS_SYM, $HAS_LBL_NUM, $HAS_FLAGS, $NE);

  &OP("LAND",         "b",          "V",  $EXP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("LDA",          "p",           "V",
      $EXP,        $LEAF, $NK, 0, $MC, $MCEXP,
      $HAS_SYM, $HAS_OFFSET, $HAS_1TY);

  &OP("LDBITS",       "i",          "s",
      $EXP, $LOAD, $LEAF, $NK, 0, $MC, $MCLDST,
      $HAS_SYM, $HAS_OFFSET, $HAS_1TY);

#LDID can only have a limited range of return types
  &OPKEEP(I8I8LDID);  &OPKEEP(I8I2LDID);  &OPKEEP(I8I1LDID);  &OPKEEP(I8I4LDID);
  &OPKEEP(I4I4LDID);  &OPKEEP(I4I2LDID);  &OPKEEP(I4I1LDID);  &OPKEEP(I4I8LDID);
  &OPKEEP(U8U8LDID);  &OPKEEP(U8U2LDID);  &OPKEEP(U8U1LDID);  &OPKEEP(U8U4LDID);
  &OPKEEP(U4U4LDID);  &OPKEEP(U4U2LDID);  &OPKEEP(U4U1LDID);  &OPKEEP(U4U8LDID);
  &OPKEEP(F4F4LDID);  &OPKEEP(F8F8LDID);  &OPKEEP(FQFQLDID);
  &OPKEEP(C4C4LDID);  &OPKEEP(C8C8LDID);  &OPKEEP(CQCQLDID);
  &OPKEEP(A4A4LDID);  &OPKEEP(A8A8LDID);  &OPKEEP(MMLDID);
  &OPKEEP(I4BSLDID);  &OPKEEP(I8BSLDID);
  &OPKEEP(U4BSLDID);  &OPKEEP(U8BSLDID);
  &OPKEEP(F10F10LDID); &OPKEEP(F16F16LDID);
  &OPKEEP(C10C10LDID); &OPKEEP(C16C16LDID);
  &OP("LDID",         "i,f,z,p,M",       "i,f,z,s,p,M,bs",
      $EXP, $LOAD, $LEAF, $NK, 0, $MC, $MCLDST,
      $HAS_SYM, $HAS_OFFSET, $HAS_1TY);

  &OP("LE",           "b",          "i,f,p",
      $EXP, $CMP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("LIOR",         "b",          "V",  $EXP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("LNOT",         "b",          "V",  $EXP, $NK, 1, $MC, $MCEXP, $BOOL);

# LOOP_INFO has 0-2 kids
  &OP("LOOP_INFO",	"V",	"V",	$EXP, $HAS_2OFFSETS,
      $HAS_FLAGS, $MC, $MCEXP);

  &OP("LOWPART",      "i",          "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("LSHR",         "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("LT",           "b",          "i,f,p",
      $EXP, $CMP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("MADD",         "f",          "V",  $EXP, $NK, 3, $MC, $MCEXP);

  &OP("MAX",          "i,f,p",      "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("MAXPART",      "i,f",        "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("MIN",          "i,f,p",      "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("MINMAX",       "i,f,p",      "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("MINPART",      "i,f",        "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("MLOAD",        "M",          "V",  $EXP, $LOAD, $NK, 2, $MC, $MCLDST,
      $HAS_1TY, $HAS_OFFSET);

  &OP("MOD",          "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("MPY",          "i,f,z",      "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("MSTORE",	      "V",          "V",  $STMT, $STORE, $NK, 3,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_OFFSET, $HAS_1TY);

  &OP("MSUB",         "f",          "V",  $EXP, $NK, 3, $MC, $MCEXP);

  &OP("NE",           "b",          "i,f,z,p",
      $EXP, $CMP, $NK, 2, $MC, $MCEXP, $BOOL);

  &OP("NEG",          "i,f,z",      "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("NMADD",        "f",          "V",  $EXP, $NK, 3, $MC, $MCEXP);

  &OP("NMSUB",        "f",          "V",  $EXP, $NK, 3, $MC, $MCEXP);

  &OP("OPTPARM",       "i,f,z",	      "V",  $EXP, $NK, 1, $MC, $MCEXP, $NE);

  &OP("OPT_CHI",       "V",	      "V", $STMT, $NK, 0, $MC, $MCSTMT, $HAS_NEXT_PREV);

  &OP("OPT_RESERVE2",  "V",           "V", $STMT, $NK, 0, $MC, $MCSTMT, $NE);

  &OP("PAREN",        "f,z",        "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("PARM",       "i,f,M,z,V,p",   "V",  $EXP, $NK, 1, $MC, $MCEXP, $NE,
	$HAS_1TY, $HAS_FLAGS);

#PICCALL can only have a limited range of return types
  &OPKEEP(I1PICCALL);  &OPKEEP(I2PICCALL);  &OPKEEP(I4PICCALL);  &OPKEEP(I8PICCALL);
  &OPKEEP(U1PICCALL);  &OPKEEP(U2PICCALL);  &OPKEEP(U4PICCALL);  &OPKEEP(U8PICCALL);
  &OPKEEP(I4I4PICCALL); &OPKEEP(I8I8PICCALL); &OPKEEP(U4U4PICCALL); &OPKEEP(U8U8PICCALL);
  &OPKEEP(F4PICCALL);  &OPKEEP(F8PICCALL);  &OPKEEP(FQPICCALL);
  &OPKEEP(C4PICCALL);  &OPKEEP(C8PICCALL);  &OPKEEP(VPICCALL);
  &OPKEEP(F4F4PICCALL); &OPKEEP(F4F8PICCALL); &OPKEEP(F8F4PICCALL); &OPKEEP(F8F8PICCALL);
  &OPKEEP(A4PICCALL); &OPKEEP(A8PICCALL);
  &OPKEEP(F10PICCALL); &OPKEEP(F16PICCALL);
  &OP("PICCALL",        "s,i,f,z,V,p",  "i,F4,F8,V,p",  $STMT, $CALL, $EBB,
      $MC, $MCCALL, $HAS_NEXT_PREV, $HAS_SYM, $HAS_FLAGS);

  &OP("PRAGMA",       "V",          "V",  $STMT, $LEAF, $NK, 0, $MC, $MCPR,
      $HAS_NEXT_PREV, $HAS_VALUE, $HAS_OFFSET, $HAS_SYM, $NE); 

  &OP("PREFETCH",     "V",          "V",  $STMT, $NK, 1, $MC, $MCSTMT,
      $HAS_NEXT_PREV, $HAS_FLAGS, $HAS_OFFSET, $PREF);

  &OP("PREFETCHX",     "V",          "V",  $STMT, $NK, 2, $MC, $MCSTMT,
      $HAS_NEXT_PREV, $HAS_FLAGS, $HAS_OFFSET, $PREF);

  &OP("RCOMMA",        "i,f,z,p,M",   "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("REALPART",     "f",          "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("RECIP",        "f,z",        "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("REGION",       "V",          "V",  $SCF, $NK, 3, $MC, $MCHDR,
      $HAS_NEXT_PREV, $HAS_EREG_SUPP);

  &OP("REGION_EXIT",  "V",          "V",  $STMT, $LEAF, $NSCF, $EBB,
      $NK, 0, $MC, $MCSTMT, $HAS_NEXT_PREV, $HAS_SYM, $HAS_LBL_NUM);

  &OP("REM",          "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("RETURN",       "V",          "V",  $STMT, $NSCF, $EBB,
      $NK, 0, $MC, $MCSTMT, $HAS_NEXT_PREV);

  &OP("RETURN_VAL",   "V",          "s,i,f,z,p,M",  $STMT, $NSCF, $EBB,
      $NK, 1, $MC, $MCSTMT, $HAS_NEXT_PREV);

  &OP("RND",          "i",	    "f",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("RSQRT",        "f,z",        "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("SELECT",       "i,f,z,b,p",  "b,V",  $EXP, $NK, 3, $MC, $MCEXP);

  &OP("SHL",          "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("SQRT",         "f,z",        "V",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("STBITS",         "V",          "s", $STMT, $STORE, $NK, 1,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_SYM, $HAS_OFFSET, $HAS_1TY);

  &OP("STID",         "V",          "s,i,f,z,M,p,bs", $STMT, $STORE, $NK, 1,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_SYM, $HAS_OFFSET, $HAS_1TY);
  &OP("PSTID",         "V",          "s,i,f,z,M,p,bs", $STMT, $STORE, $NK, 1,
      $MC, $MCLDST, $HAS_NEXT_PREV, $HAS_SYM, $HAS_OFFSET, $HAS_1TY);


  &OP("SUB",          "i,f,z,p",      "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("SWITCH",       "V",          "V",  $STMT, $NSCF, $MC, $MCSCF, $EBB,
      $HAS_NEXT_PREV, $HAS_NE, $HAS_LAST_LABEL);

  &OP("TAS",          "s,i,f,z,p",    "V",  $EXP, $NK, 1, $MC, $MCEXP,
      $HAS_1TY);

  &OP("TRAP",		"V",	"V",	$STMT, $HAS_OFFSET, $NK, 0, 
	$HAS_NEXT_PREV, $MC, $MCSTMT);

  &OP("TRIPLET",	"i",	"V",	$EXP, $NK, 3, $MC, $MCEXP);

  &OP("SRCTRIPLET",	"i",	"V",	$EXP, $NK, 3, $MC, $MCEXP); //April

  &OP("TRUEBR",       "V",          "V",  $STMT, $NSCF, $EBB,
      $NK, 1, $MC, $MCSTMT, $HAS_NEXT_PREV, $HAS_LBL_NUM);

  &OP("TRUNC",        "i",	    "f",  $EXP, $NK, 1, $MC, $MCEXP);

  &OP("VFCALL",        "s,i,f,z,V,p",  "i,F4,F8,V,p",  $STMT, $CALL, $EBB,
      $MC, $MCCALL, $HAS_NEXT_PREV, $HAS_1TY, $HAS_FLAGS);

  &OP("WHERE",		"V",	"V",	$SCF, $NK, 3, $MC, $MCSCF, $HAS_NEXT_PREV);

  &OP("WHILE_DO",     "V",          "V",  $SCF, $NK, 2, $MC, $MCSCF,
      $HAS_NEXT_PREV);

  &OP("XGOTO",     "V",          "V",  $STMT, $NSCF, $MC, $MCSCF, $EBB,
      $HAS_NEXT_PREV, $HAS_NE, $HAS_SYM);

  &OP("XMPY",          "i",          "V",  $EXP, $NK, 2, $MC, $MCEXP);

  &OP("XPRAGMA",      "V",          "V",  $STMT, $MC, $MCPR,
      $HAS_NEXT_PREV, $HAS_OFFSET, $HAS_SYM, $NE); 


  &OP("USE",   "V",          "V",  $SCF, $MC, $MCHDR,
      $HAS_NEXT_PREV, $HAS_SYM);

  &OP("NAMELIST",   "V",          "V",  $SCF, $MC, $MCHDR,
      $HAS_NEXT_PREV, $HAS_SYM);

  &OP("IMPLICIT_BND",   "V",          "V",  $SCF, $MC, $MCHDR,
      $HAS_NEXT_PREV, $HAS_SYM);


#
# Generate the statically initialized table of functions called
# by the simplifier for each generic operator. This must be done after all
# opcodes are defined. It is done in this file so that when new opcodes
# and operators are added, the simplifier tables are appropriately updated
#
  &SIMP_OP("CVT","simp_cvt");
  &SIMP_OP("TAS","simp_cvt");
  &SIMP_OP("TRUNC","simp_cvt");
  &SIMP_OP("NEG","simp_neg");
  &SIMP_OP("ABS","simp_abs");
  &SIMP_OP("SQRT","simp_recip");
  &SIMP_OP("REALPART","simp_cvt");
  &SIMP_OP("IMAGPART","simp_cvt");
  &SIMP_OP("BNOT","simp_not");
  &SIMP_OP("LNOT","simp_not");
  &SIMP_OP("ADD","simp_add_sub");
  &SIMP_OP("SUB","simp_add_sub");
  &SIMP_OP("MPY","simp_times");
  &SIMP_OP("DIV","simp_div");
  &SIMP_OP("MOD","simp_mod_rem");
  &SIMP_OP("REM","simp_mod_rem");
  &SIMP_OP("MAX","simp_min_max");
  &SIMP_OP("MIN","simp_min_max");
  &SIMP_OP("BAND","simp_band");
  &SIMP_OP("BIOR","simp_bior");
  &SIMP_OP("BNOR","simp_bnor");
  &SIMP_OP("BXOR","simp_bxor");
  &SIMP_OP("LAND","simp_land");
  &SIMP_OP("LIOR","simp_lior");
  &SIMP_OP("SHL","simp_shift");
  &SIMP_OP("ASHR","simp_shift");
  &SIMP_OP("LSHR","simp_shift");
  &SIMP_OP("RECIP","simp_recip");
  &SIMP_OP("RSQRT","simp_recip");
  &SIMP_OP("EQ","simp_eq_neq");
  &SIMP_OP("NE","simp_eq_neq");
  &SIMP_OP("LT","simp_relop");
  &SIMP_OP("LE","simp_relop");
  &SIMP_OP("GT","simp_relop");
  &SIMP_OP("GE","simp_relop");

  &END_OP();

# end of main program

}

###########################################################################
###########################################################################
###########################################################################
###########################################################################
###
### PART II: The perl routines to implement these tables and generate C code.
###
###########################################################################
###########################################################################
###########################################################################
###########################################################################


sub OUTFILES {
  $#_ == 3 || die "OUTFILES: requires four arguments exactly";

  open(HFILET, ">" . $_[0]);
  open(HFILED, ">" . $_[1]);
  open(CFILET, ">" . $_[2]);
  open(SFILET, ">" . $_[3]);

  printf(HFILET "/* $_[0]: This file automatically generated. */\n\n");
  printf(HFILED "/* $_[1]: This file automatically generated. */\n\n");
  printf(CFILET "/* $_[2]: This file automatically generated. */\n\n");
  printf(SFILET "/* $_[3]: This file automatically generated. */\n\n");

  printf("Automatically generating $_[0]\n");
  printf("Automatically generating $_[1]\n");
  printf("Automatically generating $_[2]\n");
  printf("Automatically generating $_[3]\n");
}

sub BEGIN_WHIRLTYPE {
    undef %typeval;
    $type_count = 0;
}

sub WHIRLTYPE {
    local ($typename);
    $typename = pop(@_);
    $basetype{$typename} = 1;
    $typeval{$typename} = ++$type_count;
}

sub ABBREVTYPE {
  local($i);

  $newtype = $_[$0];

  # sanity check: make sure that the abbrevtype components are basetypes.

  !defined($abbrevtype{$newtype}) || die "ABBREVTYPE: $newtype redefined";
  for ($i = 1; $i <= $#_; $i++) {
    local($type) = $_[$i];
    defined($basetype{$type}) || die "ABBREVTYPE: $type is not a basetype";
  }

  $abbrevtype{$newtype} = join(",", @_[1 .. $#_]);
}

#
# generate the #defines in the .h for the type system, and generate
# a mapping to strings for the .c file.
#

sub END_WHIRLTYPE {
  local($key);
  local($tname);

# We no longer need to print a table of names, just include mtypes.h!
  if (0) {
    printf(HFILET "/* For lookup the string representation of a type */\n\n");
    printf(HFILET "extern struct " . $OPTYPE_PREFIX . "info_struct {\n" .
	   "  char name[4];\n" .
	   "} %s[];\n\n", 
	   $OPTYPE_PREFIX . "info");

    printf(CFILET "struct ". $OPTYPE_PREFIX . "info_struct %s[] = {\n" .
	   "  \"TY?\",\n", $OPTYPE_PREFIX . "info");

    printf(HFILET "/* Definition of type %s */\n\n", $OPTYPE_TYPE);
    printf(HFILET "typedef enum {\n");
    printf(HFILET "  %s = %d,\n", $OPTYPE_TYPE . "_FIRST", 1);

    local($i) = 0;
    foreach $key (keys %basetype) {
      local($tname) = $OPTYPE_PREFIX . $key;
      printf(HFILET "  %s = %d,\n", $tname, ++$i);
      printf(CFILET "  \"%s\",\n", $key);
    }
    printf(HFILET "  %s = %d\n", $OPTYPE_TYPE . "_LAST", $i);
    printf(HFILET "} %s;\n\n", $OPTYPE_TYPE);
    printf(CFILET "};\n\n");
  }
  else {
    printf(HFILET "#ifndef mtypes_INCLUDED\n");
    printf(HFILET "#include \"mtypes.h\"\n");
    printf(HFILET "#endif\n\n");
  }
}

sub BEGIN_PROPERTY {
  $prop_cnt = 0;
}

sub NEW_PROPERTY {
  $#_ == 1 || die "Bad number of args to NEW_PROPERTY";
  ($_[0] && $_[1]) || die "missing property or type in NEW_PROPERTY";
  $prop_isv[$prop_cnt] = 0;
  $prop_name[$prop_cnt] = $_[0];
  $prop_type[$prop_cnt] = $_[1];
  $prop_number{$prop_name[$prop_cnt]} = $prop_cnt;
  $prop_cnt++;
}

sub NEW_VALUED_PROPERTY {
  # "i"        integral value
  # "e"        enumeration value i.e. copy the string
  # "s"        string value, i.e. put quotation marks around the string

  $#_ == 2 || $#_ == 3 || die "Bad number of args to NEW_PROPERTY";
  ($_[0] && $_[1]) || die "missing property or type in NEW_PROPERTY";
  $prop_isv[$prop_cnt] = 1;
  $prop_name[$prop_cnt] = $_[0];
  $prop_type[$prop_cnt] = $_[1];
  $prop_reptype[$prop_cnt] = $_[2];
  $prop_default_v[$prop_cnt] = $_[3] if ($#_ == 3);
  $prop_number{$prop_name[$prop_cnt]} = $prop_cnt;
  $prop_name[$prop_cnt] ne 'flag' ||
    die "$prop_name[$prop_cnt]: valued property cannot be flag";
  $prop_reptype[$prop_cnt] eq "i" ||
    $prop_reptype[$prop_cnt] eq "e" ||
      $prop_reptype[$prop_cnt] eq "s" ||
	die "illegal prop_reptype: $prop_reptype[$prop_cnt]";
  $prop_cnt++;
}

# END_PROPERTY
#
# process all properties: make a C structure containing all properties,
# and write accessor functions.
#
# This procedure defines and exports
#
# prop_flag_cnt          the number of flag properties.
# INFO                   the name of the C opcode information object
# INFO_STRUCT            the name of the C opcode information object structure
# PROPERTY_PREFIX        the prefix for properties that are flags
# VALUED_PROPERTY_PREFIX the prefix for properties that are values
# opcode_string_size     bytes allocated for the opcode name
#
# also defined by the properties are
#
# prop_cnt               the number op properties ($#prop_name+1)
# prop_isv               array indexed by number, flag, whether is valued
# prop_name              array indexed by number, of name
# prop_type              array indexed by number, of user specified C type
# prop_reptype           "i" C integer; "e" C enum; "s" C string
# prop_default_v         array indexed by number, of value (defined when isv)
# prop_number            assoc array mapping name->number, inverse of prop_name
#
# Limit properties to 32.  More than that, either return a different field or
# compare to zero or something.  I don't want (1<<54) being returned and then
# cast to an int.

sub END_PROPERTY {
  local($i);
  local(%prop_name_seen);

  $prop_flag_cnt = 0;
  $INFO = $GENERAL_PREFIX . "info";
  $INFO_STRUCT = $GENERAL_PREFIX . "info_struct";
  $PROPERTY_PREFIX = $GENERAL_PREFIX . "PROPERTY_";
  $opcode_string_size = 32;

  # define the property and info structure

  printf(HFILET "/* operators, types, and attributes of the opcodes */\n\n");
  printf(HFILET "extern struct %s {\n", $INFO_STRUCT);
  printf(HFILET "  char%s_name[%d];\n", &tabs(2, 6), $opcode_string_size);
  printf(HFILET "  mUINT16%s_operator;\n", &tabs(2, 9));
  printf(HFILET "  mUINT8%s_rtype;\n", &tabs(2, 8));
  printf(HFILET "  mUINT8%s_desc;\n", &tabs(2, 8));

  for ($i = 0; $i < $prop_cnt; $i++) {
    local($pname) = $prop_name[$i];
    local($ptype) = $prop_type[$i];

    !defined($prop_name_seen{$pname}) || die "property $pname redefined";

    if ($ptype eq 'flag') {
      $prop_flag_cnt++;
    }
    else {
      printf(HFILET "  %s%s%s;\n", $ptype, &tabs(2, 2, $ptype), $pname);
    }
  }

  if ($prop_flag_cnt > 0) {
    if ($prop_flag_cnt <= 32) {
      $prop_flag_type = "mUINT32";
    }
    elsif ($prop_flag_cnt <= 64) {
      $prop_flag_type = "mUINT64";
    }
    else {
      die "too many properties: %d";
    }
    printf(HFILET "  %s%s_flags;\n", $prop_flag_type, &tabs(2, 9));
  }

  printf(HFILET "} %s[];\n\n", $INFO);

  # #define any flags of interest (for flags) into the .h file.

  if ($prop_flag_cnt > 0) {
    printf(HFILET "/* Flag property bits, field _flag */\n\n");
    local($bit) = 1;
    for ($i = 0; $i < $prop_cnt; $i++) {
      local($ptype) = $prop_type[$i];
      next if ($ptype ne 'flag');
      local($pname) = $prop_name[$i];
      local($pflag) = $PROPERTY_PREFIX . $pname;
      printf(HFILET "#define %s%s0x%08x\n", $pflag, &tabs(6, 8, $pflag), $bit);
      $bit *= 2;
    }
    printf(HFILET "\n");
  }

  # put accessor macros for fields into the .h file.

  printf(HFILED "/* macros for looking up field values */\n");
  printf(HFILED "/* (silly check: should be inlined and typechecked) */\n\n");

  local($paranoid_check) = "  Is_True(op >= " . $OP_TYPE . "_FIRST && " .
    "op <= " . $OP_TYPE . "_LAST, (\"Bad opcode %d\", op));\n";

  printf(HFILED "/*REFERENCED*/\n");
  printf(HFILED "inline %s %s_operator(%s op)\n{\n%s" . 
	        "  return (%s)(%s[op]._operator);\n}\n\n",
	 $GOP_TYPE, $OP_TYPE, $OP_TYPE, $paranoid_check,
	 $GOP_TYPE, $INFO);
  printf(HFILED "/*REFERENCED*/\n");
  printf(HFILED "inline %s %s_rtype(%s op)\n{\n%s" . 
	        "  return (%s)(%s[op]._rtype);\n}\n\n",
	 $OPTYPE_TYPE, $OP_TYPE, $OP_TYPE, $paranoid_check,
	 $OPTYPE_TYPE, $INFO);
  printf(HFILED "/*REFERENCED*/\n");
  printf(HFILED "inline %s %s_desc(%s op)\n{\n%s" .
	        "  return (%s)(%s[op]._desc);\n}\n\n",
	 $OPTYPE_TYPE, $OP_TYPE, $OP_TYPE, $paranoid_check,
	 $OPTYPE_TYPE, $INFO);
  printf(HFILED "/*REFERENCED*/\n");
  printf(HFILED "inline const char *%s_name(%s op)\n{\n%s" . 
	        "  return (const char *)(%s[op]._name);\n}\n\n",
	 $OP_TYPE, $OP_TYPE, $paranoid_check, $INFO);

  # put accessor macros for properties into the .h file.

  printf(HFILED "/* Inlines for looking up attribute values */\n\n");

  for ($i = 0; $i < $prop_cnt; $i++) {
    local($pname) = $prop_name[$i];
    local($ptype) = $prop_type[$i];

    if ($ptype eq 'flag') {
      local($pflag) = $PROPERTY_PREFIX . $pname;
      local($prefix) = $property_accessor_prefix{$pname};
      if ($prefix eq '') {$prefix = $PROPERTY_ACCESSOR_PREFIX};
      printf(HFILED "/*REFERENCED*/\n");
      printf(HFILED "inline %s %s(%s op)\n{\n%s" .
	            "  return (%s) (%s[op]._flags &\n\t\t\t%s);\n}\n\n",
	     $prop_flag_type, $prefix . $pname, $OP_TYPE, $paranoid_check,
	     $prop_flag_type, $INFO, $pflag);
    }
    elsif ($prop_isv[$i]) {
      printf(HFILED "/*REFERENCED*/\n");
      printf(HFILED
	     "inline %s %s(%s op)\n{\n%s  return %s[op].%s;\n}\n\n",
	     $ptype, $VALUED_PROPERTY_ACCESSOR_PREFIX . $pname,
	     $OP_TYPE, $paranoid_check, $INFO, $pname);
    }
    else {
      local($prefix) = $property_accessor_prefix{$pname};
      if ($prefix eq '') {$prefix = $PROPERTY_ACCESSOR_PREFIX};
      printf(HFILED "/*REFERENCED*/\n");
      printf(HFILED "inline UINT32 %s(%s op)\n{\n%s" .
	            "  return (UINT32) %s[op].%s;\n}\n\n",
	     $prefix . $pname, $OP_TYPE, $paranoid_check, $INFO, $pname);
    }
  }

  # handle black-box that doesn't have associated property
  printf(HFILED "/*REFERENCED*/\n");
  printf(HFILED "inline BOOL OPCODE_is_black_box( OPCODE opc )\n");
  printf(HFILED "{\n");
  printf(HFILED "  return ( opc == OPC_IO );\n");
  printf(HFILED "}\n");
}

sub SIMP_OP {
    local($oname) = $_[0];
    local($sfunc) = $_[1];
    $oname = $GOP_PREFIX . $oname;
    $simp_func_name{$oname} = $sfunc;
}

sub BEGIN_OP {
}

#
# OP communicates to END_OP via
#       gop_cnt: the number of distinct generic operators
#       gop_name: maps the gop number (1 to gop_cnt) to the name
#       gop_shortname: as above, but without the prefix.
#       gop_info: maps gop number to an ^-separated data structure containing
#           "^rtype1^desc1^props1^rtype2^desc2^props2^..."
#           where rtype is the return type name
#           where desc is the descriptor type name
#           where prop are all the properties, connected via @.
#

# comment for all operators with a given name, e.g. ADD
sub GOPCOMMENT {
  $gopcomment{$_[0]} = $_[1];
}

# comment for specific opcode with a given name, e.g. F8ADD
sub OPCOMMENT {
  $opcomment{$OP_PREFIX . $_[0]} = $_[1];
}

sub OPIGN {
  $ignoring_on = 1;
  $opignore{$OP_PREFIX . $_[0]} = 1;
  die "Cannot both ignore and keep" if $keeping_on == 1
}

sub OPKEEP {
  $keeping_on = 1;
  $opkeep{$OP_PREFIX . $_[0]} = 1;
  die "Cannot both ignore and keep" if $ignoring_on == 1
}

sub OP {
  local($tt);
  local($dd);
  local($i);

  local($gname) = $_[0];
  local(@rtype) = &makebasetypearray($_[1]);
  local(@desc) = &makebasetypearray($_[2]);
  local($props) = join("@", @_[3 .. $#_]);

  $keeping{$gname} = $keeping_on;
  $ignoring{$gname} = $ignoring_on;
  $keeping_on = 0;
  $ignoring_on = 0;

  for ($i = 3; $i <= $#_; $i++) {
    local($pname) = $_[$i];
    local($pnum) = $prop_number{$pname};
    defined($pnum) || die "unknown property $pname for $gname";
    $i++ if ($prop_isv[$pnum]);
  }

  if (!defined($gop_number{$gop})) {
    $gop_number{$gname} = ++$gop_cnt;
    $gop_name[$gop_cnt] = $GOP_PREFIX . $gname;
    $gop_shortname[$gop_cnt] = $gname;
  }

  # store with each gop name a list of legal types and flags.

  local($gnum) = $gop_number{$gname};

  for $tt (@rtype) {
    for $dd (@desc) {
      # if this tt and dd match a previously entered one, make sure
      # the properties are the same.  If no match, put in gop_info.

      local(@data) = split(/\^/, $gop_info[$gnum]);
      local($i);
      local($duplicate_seen) = 0;
      for ($i = 1; $i < $#data; $i += 3) {
	if ($data[$i] eq $tt && $data[$i+1] eq $dd) {
	  $duplicate_seen = 1;
	  $data[$i+2] == $props ||
	    die "$gname (rtype:$tt, desc:$dd) has inconsistent flags" .
	      "$data[$i+2] and $props";
	  break;
	}
      }
      if ($duplicate_seen == 0) {
	$gop_info[$gnum] = join("^", $gop_info[$gnum], $tt, $dd,
				$props);
      }
    }
  }
}

#
# Now that we've seen all the operators, generate initialization code.
#

sub END_OP {
  local($gnum);
  local($gsname);
  local($rtscnt);
  local($dscnt);
  local(@opfirst);
  local(@oplast);
  local($i) = 1;
  local($j);

  #
  # '#define' the generic operators and put in the .h file.
  #

  printf(HFILET "/* Definition of type %s */\n\n", $GOP_TYPE);
  printf(HFILET "#define OPR_DIVPART OPR_LOWPART\n");
  printf(HFILET "#define OPR_REMPART OPR_HIGHPART\n");
  printf(HFILET "\n");
  printf(HFILET "typedef enum {\n");
  printf(HFILET "  %s = %d,\n", $GOP_TYPE . "_UNKNOWN", 0);
  printf(HFILET "  %s = %d,\n", $GOP_TYPE . "_FIRST", $i);

  for ($gnum = 1; $gnum <= $gop_cnt; $gnum++) {
    local($gname) = $gop_name[$gnum];
    printf(HFILET "  %s = %d,\n", $gname, $i++);
  }
  printf(HFILET "  %s = %d\n", $GOP_TYPE . "_LAST", $i-1);
  printf(HFILET "} %s;\n\n", $GOP_TYPE);

  #
  # create the simplifier function dispatch table
  #
  printf(SFILET "typedef simpnode (*simpfunction)(OPCODE, simpnode, ");
  printf(SFILET "simpnode, BOOL, BOOL);\n");
  printf(SFILET "simpfunction simplify_function_table[OPERATOR_LAST+1]={\n");
  printf(SFILET "NULL, /* index 0 is not used */\n");

  for ($gnum = 1; $gnum <= $gop_cnt; $gnum++) {
    local($gname) = $gop_name[$gnum];
    local($sfunc) = $simp_func_name{$gname};
    if ($sfunc) {
	printf(SFILET "$sfunc,\t /* $gname */\n");
    } else {
	printf(SFILET "NULL, \t/* $gname */\n");
    }
  }
  printf(SFILET "};\n");

  # go through gop_info, making opcodes for the HFILET, and simultaneously,
  # fill in the info table for the opcodes in the CFILET.
  # Also, create arrays opfirst and oplast so print out the first/last
  # gop table when we're through printing out this.

  printf(HFILET "/* Definition of type %s */\n\n", $OP_TYPE);
  printf(HFILET "#define OPC_I4DIVPART OPC_I4LOWPART\n");
  printf(HFILET "#define OPC_I8DIVPART OPC_I8LOWPART\n");
  printf(HFILET "#define OPC_U4DIVPART OPC_U4LOWPART\n");
  printf(HFILET "#define OPC_U8DIVPART OPC_U8LOWPART\n");
  printf(HFILET "#define OPC_I4REMPART OPC_I4HIGHPART\n");
  printf(HFILET "#define OPC_I8REMPART OPC_I8HIGHPART\n");
  printf(HFILET "#define OPC_U4REMPART OPC_U4HIGHPART\n");
  printf(HFILET "#define OPC_U8REMPART OPC_U8HIGHPART\n");
  printf(HFILET "\n");
  printf(HFILET "typedef enum {\n");
  printf(HFILET "  %s = %d,\n", $OP_TYPE . "_UNKNOWN", 0);
  printf(HFILET "  %s = %d,\n", $OP_TYPE . "_FIRST", 1);

  printf(CFILET "/* Initialization of opcode information */\n\n");

  # cast to packed type
  printf(CFILET "#define PGOP(x)\t((mUINT16)(x))\n");
  printf(CFILET "#define PTYPE(x)\t((mUINT8)(x))\n\n");

  printf(CFILET "struct %s %s[] = {\n" .
	 "  {\"UNKNOWN_OPCODE\"},\n" ,
	 $INFO_STRUCT, $INFO);

  $opcnt = 0;
  for ($gnum = 1; $gnum <= $gop_cnt; $gnum++) {
    local(%rts);
    local(%ds);

    local($gsname) = $gop_shortname[$gnum];
    local(@data) = split(/\^/, $gop_info[$gnum]);

    for ($i = 1; $i < $#data; $i += 3) {
      $rts{$data[$i]} = 1;
      $ds{$data[$i+1]} = 1;
    }

    # don't know a better way to cnt the elements in an assoc array
    $rtscnt = 0;
    while (($dummy, $dummy2) = each %rts) {
      $rtscnt++;
    }
    $rtscnt > 0 || die "bad rtscnt for $gsname";
    $dscnt = 0;
    while (($dummy, $dummy2) = each %ds) {
      $dscnt++;
    }
    $dscnt > 0 || die "bad dscnt for $gsname";

    $opfirst[$gnum] = $opcnt+1;

    for ($i = 1; $i < $#data; $i += 3) {
      $opcnt++;

      local($rt) = $data[$i];
      local($d) = $data[$i+1];
      local(@p) = split(/@/, $data[$i+2]);
      local($name) = $OP_PREFIX;

      ($name = $name . $rt) unless ($rtscnt <= 1);
      # rather than check for only 1 dscnt, instead check for V ds
      ($name = $name . $d) unless ($d eq 'V');
      $name = $name . $gsname;

      if (($ignoring{$gsname} && $opignore{$name}) ||
	  ($keeping{$gsname} && !$opkeep{$name})) {
	$opcnt--;
	next;
      }

      if ($do_keep) {
	printf "%s, %s\n", $name, $opkeep{$name}
      }

      $rt = $OPTYPE_PREFIX . $rt;
      $d = $OPTYPE_PREFIX . $d;

      # define the opcodes

      printf(HFILET "  %s = %d,", $name, $opcnt);
      if (defined($opcomment{$name})) {
	printf(HFILET "  /* %s */", $opcomment{$name});
      }
      if (defined($gopcomment{$gsname})) {
	printf(HFILET "  /* %s */", $gopcomment{$gsname});
      }
      printf(HFILET "\n");

      !defined($names_check{$name}) ||
	die "duplicate opcode name $name from $gnum";
      $names_check{$name} = $opcnt;
      $names[$opcnt] = $name;

      # print out the info fields.  This is no fun.  Here's a slow way:
      # for each property in the world, it is either on the property
      # list or not.  If it's not, then value is zero.  If it is, value
      # is one.  Exception: if it's a flag, then either _flags field
      # has that bit set or not.

      local($ftext) = "";
      printf(CFILET "  {\"%s\", PGOP(%s), PTYPE(%s), PTYPE(%s),\n",
	     $name, $gop_name[$gnum], $rt, $d);
      length($name) < $opcode_string_size ||
	die "$name: op string size $opcode_string_size too short";

      #
      # first put properties and their values into an associative array
      # for easy future access.  Put a dummy value in if not a value-prop.
      #

      local(%pr);
      local($pcnt);
      for ($pcnt = 0; $pcnt <= $#p; $pcnt++) {
	local($pname) = $p[$pcnt];
	local($pnum) = $prop_number{$pname};
	defined($pnum) || die "$name: unknown property $pname, 2nd check!";
	$pr{$pname} = ($prop_isv[$pnum]) ? $p[++$pcnt] : "<flagset>";
      }

      #
      # Now go through all properties and see which are defined
      #

      local($pnum);
      for ($pnum = 0; $pnum < $prop_cnt; $pnum++) {
	local($pname) = $prop_name[$pnum];
	local($ptype) = $prop_type[$pnum];

	if ($ptype eq 'flag') {
	  # flag, so set if has value
	  if ($pr{$pname}) {
	    $pr{$pname} eq "<flagset>" ||
	      die "$name: non-val attribute $pname initialized: $pr{$pname}";
	    local($pp) = $PROPERTY_PREFIX . $pname;
	    $ftext = ($ftext eq "") ? $pp : $ftext . "|" . $pp;
	  }
	}
	elsif (!$prop_isv[$pnum]) {
	  # not a value attribute, so either zero or 1.
	  local($val) = 0;
	  if ($pr{$pname}) {
	    $pr{$pname} eq "<flagset>" ||
	      die "$name: non-val attribute $pname initialized: $pr{$pname}";
	    $val = 1;
	  }
	  local($outstring);
	  $outstring = "   %d /* %s */," if ($prop_reptype[$pnum] eq "i");
	  $outstring = "   %s /* %s */," if ($prop_reptype[$pnum] eq "e");
	  $outstring = "   \"%s\" /* %s */," if ($prop_reptype[$pnum] eq "s");
	  printf(CFILET $outstring, $val, $pname);
	}
	else {
	  # a value attribute, which was either supplied a value
	  # or has a default

	  local($val) = $pr{$pname} ? $pr{$pname} :
	    defined($prop_default_v[$pnum]) ? $prop_default_v[$pnum] :
	      die "$name: val'd attribute $pname not supplied, has no default";

	  local($outstring);
	  $outstring = "   %d /* %s */," if ($prop_reptype[$pnum] eq "i");
	  $outstring = "   %s /* %s */," if ($prop_reptype[$pnum] eq "e");
	  $outstring = "   \"%s\" /* %s */," if ($prop_reptype[$pnum] eq "s");
	  printf(CFILET $outstring, $val, $pname);
	}
      }
      if ($prop_flag_cnt > 0) {
	printf(CFILET "\n    %s", ($ftext eq "" ? "0" : $ftext));
      }
      printf(CFILET "},\n");
    }

    $oplast[$gnum] = $opcnt;
  }
  printf(HFILET "  %s = %d\n", $OP_TYPE . "_LAST", $opcnt);
  printf(HFILET "} %s_XXX;\n\n", $OP_TYPE);

  printf(HFILET "typedef UINT32 %s;\n\n", $OP_TYPE);

  printf(CFILET "};\n\n");
  printf(CFILET "#undef PGOP\n");
  printf(CFILET "#undef PTYPE\n");

  #
  # Now print out generic information: the string name, the first op
  # that has that generic, and the last op that has that generic.
  #

  local($gsize) = 20;
  printf(HFILET "/* define CONDBR to be same as TRUEBR */\n");
  printf(HFILET "#define OPR_CONDBR OPR_TRUEBR\n");
  printf(HFILET "#define OPC_CONDBR OPC_TRUEBR\n\n");
  printf(HFILET "/* For a GTR_OPCODE, the first and last OPCODE */\n\n");
  printf(HFILET "extern struct %sgop_info_struct {\n", $GENERAL_PREFIX);
  printf(HFILET "  char name[%d];\n", $gsize);
  printf(HFILET "  OPCODE first;\n");
  printf(HFILET "  OPCODE last;\n");
  printf(HFILET "} %sgop_info[];\n\n", $GENERAL_PREFIX);

  #
  # close out the ifdef
  #

  printf(HFILET "#ifdef __cplusplus\n");
  printf(HFILET "}\n");
  printf(HFILET "#endif\n\n");

  printf(HFILET "#endif /* ifndef opcode_gen_core_INCLUDED */\n");

  printf(CFILET "struct %sgop_info_struct %sgop_info[%d] = {\n",
	 $GENERAL_PREFIX, $GENERAL_PREFIX, $gop_cnt+1);
  printf(CFILET "  {\"UNKNOWN_OPERATOR\", (OPCODE)0, (OPCODE)0},\n");

  for ($gnum = 1; $gnum <= $gop_cnt; $gnum++) {
    local($gsname) = $gop_shortname[$gnum];
    length($gsname) < $gsize || die "gop string size $gsize too short";
    printf(CFILET "  {\"%s\", %s, %s},\n", $gsname,
	   $names[$opfirst[$gnum]], $names[$oplast[$gnum]]);
  }

  printf(CFILET "};\n\n");

  close(HFILET);
  close(HFILED);
  close(CFILET);
}

###########################################################################
###
### Utility routines
###
###########################################################################

#
# makebasetypearray: change a type descriptor containing comma separated
# types, e.g. "i,F", into an array containing the equivalent base types, e.g.
# I J K L F.
#
# Uses the global associative array abbrevtype, which contains the mapping from
# types into basetypes, e.g. abbrevtype{"i"} -> I,J,K,L.

sub makebasetypearray {
  local(@x) = split(',', pop(@_)); # e.g. x might now contain i and F.
  local(%b);			# holds all the return basetypes.
  local($i);

  for ($i = 0; $i <= $#x; $i++) {
    if (defined($abbrevtype{$x[$i]})) {
      # type specified is actually a set of basetypes
      local(@entries) = split(",", $abbrevtype{$x[$i]});
      while($#entries >= 0) {
	$b{pop(@entries)} = 1;
      }
    }
    else {
      defined($basetype{$x[$i]}) || die "unknown type $x[$i]";
      $b{$x[$i]} = 1;
    }
  }

  sort bytypenumber keys(%b);
}

#
# Sort by type number
#
sub bytypenumber { $typeval{$a} <=> $typeval{$b}; }

#
# given a string, decide how many tabs to use.  The first arg is the number
# of tabstops to go out to.  The second is how far out we've already gone.
# The third, if supplied, is the size of a string that follows before the
# tabbing
#

sub tabs {
  $#_ == 1 || $#_ == 2 || die "Bad number of args to tabs";

  local($tabstops) = $_[0];
  local($out) = $_[1] + (($#_ == 2) ? length($_[2]) : 0);
  local($nt) = $tabstops - int($out/8);

  $string = $nt <= 0 ? " " : ("\t" x $nt);
}
